home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / scriptp.arc / SCRIPT.PAS
Encoding:
Pascal/Delphi Source File  |  1986-02-28  |  11.1 KB  |  312 lines
  1. program Create_Qmodem_Pcboard_Script;
  2.  
  3. { This program is written for use with Qmodem 2.0 and PcBoard Bulletin Board  }
  4. { software.  The source is included so that if you wish to, you may customize }
  5. { it to suit your own needs (run on another bulletin board perhaps).          }
  6. {                                                                             }
  7. { The program displays a menu of items, from dialing the phone, to hanging it }
  8. { up, which when selected create a Qmodem script file that will perform each  }
  9. { function with a small amount of error-trapping.  For example, it will not   }
  10. { perform an upload of a file which already exists (but the script won't      }
  11. { bomb out either!)                                                           }
  12. {                                                                             }
  13. { This program is donated to public domain by:    David W. Terry              }
  14. {                                                 3036 Putnam Ct.             }
  15. {                                                 West Valley City, Ut 84120  }
  16. {                                                 Feb. 26, 1985               }
  17. {                                                                             }
  18. { If you make changes and distribute your changed code, Please include some   }
  19. { comments to that effect....                                                 }
  20. {                                                                             }
  21. {=============================================================================}
  22. { Modified by the Lexington Board of Exchange at (606) 277-5993 on 2/28/86    }
  23. {   Added G - Logoff command to main menu                                     }
  24. {   Added delay to Upload and Download functions for reliability              }
  25. {   Added sequencing to Enter message function                                }
  26. {   Added specification of drive and path for Upload filenames                }
  27. {=============================================================================}
  28.  
  29. type
  30.   str1  = string[1];
  31.   str3  = string[3];
  32.   str12 = string[12];
  33.   str80 = string[80];
  34.  
  35. var
  36.   Command,              { Menu selection variable                             }
  37.   TransferType:  char;  { Type of File Transfer desired (X,C,Y)               }
  38.   QTransfer:     str1;  { Qmodem's Transfer type (2,3,6)                      }
  39.   FileName:      str12; { Script File Name, and later up/download names       }
  40.   FilePath:      str80; { Drive and Path for file to be uploaded              }
  41.   FileDesc:      str80; { Description of file to be uploaded                  }
  42.   Count:         byte;  { a count of the # of up/dnloads (for error trapping) }
  43.   CountStr:      str3;  { Counter converted to a string                       }
  44.   ScriptFile:    text;  { file variable for script                            }
  45.   InFile:        text;  { file variable for message entry                     }
  46.   InText:        str80; { text to be uploaded into message                    }
  47.  
  48. procedure OpenScript;
  49. begin
  50.   writeln;
  51.   write('Enter Script File Name: ');
  52.   readln(FileName);
  53.   if FileName<>'' then begin
  54.     if pos('.',FileName)=0 then begin
  55.       gotoxy(25+length(FileName),pred(WhereY));
  56.       writeln('.SCR');
  57.       FileName:=FileName+'.SCR';
  58.       end;
  59.     assign(ScriptFile,FileName);
  60.     rewrite(ScriptFile);
  61.     end;
  62.   end;
  63.  
  64. procedure GetWaitTime;
  65. var WaitTime: string[8];
  66.     TimeOk: boolean;
  67. begin
  68.   write('Enter the time to begin execution (HH:MM:SS): ');
  69.   readln(WaitTime);
  70.   if WaitTime<>'' then begin
  71.     repeat
  72.       TimeOk:=(length(WaitTime)=8) and (WaitTime[3]=':') and (WaitTime[6]=':');
  73.       if not TimeOk then begin
  74.         write(#7,'Please re-enter using military time like (13:00:00): ');
  75.         readln(WaitTime);
  76.         end;
  77.       until TimeOk;
  78.     writeln(ScriptFile,'.  ****  Wait Until ',WaitTime,' to Begin  ****');
  79.     writeln(ScriptFile);
  80.     writeln(ScriptFile,'WAITUNTIL ',WaitTime);
  81.     writeln(ScriptFile);
  82.     end;
  83.   end;
  84.  
  85. procedure DialPhone;
  86. var Number: str12;
  87. begin
  88.   write('Enter Phone Directory Entry Number to dial (prefixes allowed): ');
  89.   readln(Number);
  90.   if Number<>'' then begin
  91.     writeln(ScriptFile,'.  ****  Dial Entry #',Number,'  ****');
  92.     writeln(ScriptFile);
  93.     writeln(ScriptFile,'DIAL "',Number,'"');
  94.     writeln(ScriptFile);
  95.     end;
  96.   end;
  97.  
  98. procedure Login;
  99. var Graphics,Quick:      str1;
  100.     First,Last,Password: str80;
  101. begin
  102.   writeln(ScriptFile,'.  ****  Login to PcBoard  ****');
  103.   writeln(ScriptFile);
  104.   write('Do you want Graphics (y or n): ');
  105.   readln(Graphics);
  106.   write('Quick logon (skip logon screen - y or n): ');
  107.   readln(Quick);
  108.   if upcase(Quick)='Y' then Quick:='q' else Quick:='';
  109.   write('First Name: ');
  110.   readln(First);
  111.   write('Last Name: ');
  112.   readln(Last);
  113.   write('Password: ');
  114.   readln(Password);
  115.   writeln(ScriptFile,'WAITFOR "Want"');
  116.   writeln(ScriptFile,'SEND "',Graphics,' ',Quick,'{"');
  117.   writeln(ScriptFile);
  118.   writeln(ScriptFile,'WAITFOR "Name"');
  119.   writeln(ScriptFile,'SEND "',First,' ',Last,' ',Password,'{"');
  120.   writeln(ScriptFile);
  121.   writeln(ScriptFile,'TIMEOUT 10 RETRY');
  122.   writeln(ScriptFile,'RETRY:');
  123.   writeln(ScriptFile,'SEND "{"');
  124.   writeln(ScriptFile,'WAITFOR "Command"');
  125.   writeln(ScriptFile);
  126.   end;
  127.  
  128. procedure Logoff;
  129. begin
  130.   Count:=succ(Count);
  131.   str(Count,CountStr);
  132.   writeln(ScriptFile,'.  ****  Logoff Command  ****');
  133.   writeln(ScriptFile);
  134.   writeln(ScriptFile,'TIMEOUT 30 LOGOFF',CountStr);
  135.   writeln(ScriptFile,'SEND "{"');
  136.   writeln(ScriptFile,'WAITFOR "Command"');
  137.   writeln(ScriptFile,'SEND "G{"');
  138.   writeln(ScriptFile,'WAITFOR "calling"');
  139.   writeln(ScriptFile,'LOGOFF',CountStr,':');
  140.   writeln(ScriptFile);
  141.   end;
  142.  
  143. procedure EnterMessage;
  144. var ToName,ReText: str80;
  145.     Security: str1;
  146. begin
  147.   write('Name of Person to send message to (C/R = All, "X" = abort): ');
  148.   readln(ToName);
  149.   if upcase(ToName[1])<>'X' then begin
  150.     write('Message is about: ');
  151.     readln(ReText);
  152.     write('Security on Message (N or C/R = None,  R = Receiver): ');
  153.     readln(Security);
  154.     write('Enter name of file to be sent for message text (must exist): ');
  155.     readln(FileName);
  156.     assign(InFile,FileName); {$I-} reset(InFile); {$I+}
  157.     if IOResult<>0 then writeln('ERROR!  ',FileName,' does not exist.')
  158.       else begin
  159.         writeln(ScriptFile,'.  ****  Enter a Message  ****');
  160.         writeln(ScriptFile);
  161.         writeln(ScriptFile,'SEND "{"');
  162.         writeln(ScriptFile,'WAITFOR "Command"');
  163.         writeln(ScriptFile);
  164.         writeln(ScriptFile,'SEND "E{"');
  165.         writeln(ScriptFile,'WAITFOR "all?"');
  166.         writeln(ScriptFile);
  167.         writeln(ScriptFile,'SEND "',ToName,'{"');
  168.         writeln(ScriptFile,'WAITFOR "Subject:?"');
  169.         writeln(ScriptFile);
  170.         writeln(ScriptFile,'SEND "',ReText,'{"');
  171.         writeln(ScriptFile,'WAITFOR "None?"');
  172.         writeln(ScriptFile);
  173.         writeln(ScriptFile,'SEND "',Security,'{"');
  174.         writeln(ScriptFile,'WAITFOR "1:"');
  175.         while not eof(InFile) do begin
  176.           readln(InFile,InText);
  177.           if length(InText)<>0 then writeln(ScriptFile,'SEND "',InText,'{"')
  178.             else writeln(ScriptFile,'SEND " {"');
  179.           end;
  180.         writeln(ScriptFile,'SEND "{"');
  181.         writeln(ScriptFile,'WAITFOR "Command?"');
  182.         writeln(ScriptFile);
  183.         writeln(ScriptFile,'SEND "S{"');
  184.         writeln(ScriptFile);
  185.         close(InFile);
  186.         end;
  187.     end;
  188.   end;
  189.  
  190. procedure WriteScript(UpDown: str1);
  191. var UpDownStr: str80;
  192.     TypeOk: boolean;
  193. begin
  194.   write(' ("X"=Xmodem, "C"=Xmodem/CRC, "Y"=Ymodem): ');
  195.   repeat
  196.     readln(TransferType);
  197.     TypeOk:=(pos(upcase(TransferType),'XCY')<>0);
  198.     if not TypeOk then  write(#7,'Please Re-enter (X, C, or Y): ');
  199.     until TypeOk;
  200.   case upcase(TransferType) of
  201.     'X': QTransfer:='2';
  202.     'Y': QTransfer:='6';
  203.     'C': QTransfer:='3';
  204.     end;
  205.   case UpDown of
  206.     'U': UpDownStr:='UPLOAD ';
  207.     'D': UpDownStr:='DOWNLOAD ';
  208.     end;
  209.   Count:=succ(Count);
  210.   str(Count,CountStr);
  211.   writeln(ScriptFile,'.  ****  ',UpDownStr,FileName,'  ****');
  212.   writeln(ScriptFile);
  213.   writeln(ScriptFile,'TIMEOUT 30 NEXT',CountStr);   { Note that the TIMEOUT & }
  214.   writeln(ScriptFile,'SEND "{"');                   { NEXTcount are used for  }
  215.   writeln(ScriptFile,'WAITFOR "Command"');          { error trapping          }
  216.   writeln(ScriptFile);
  217.   writeln(ScriptFile,'TIMEOUT 1 TIME',CountStr);    { Generate delay          }
  218.   writeln(ScriptFile,'WAITFOR "!@#"');              { Guarantee timeout here  }
  219.   writeln(ScriptFile,'TIME',CountStr,':');
  220.   writeln(ScriptFile);
  221.   writeln(ScriptFile,'TIMEOUT 30 NEXT',CountStr);   { Reset to previous value }
  222.   writeln(ScriptFile);
  223.   writeln(ScriptFile,'SEND "',UpDown,' ',FileName,' ',TransferType,'{"');
  224.   writeln(ScriptFile,'WAITFOR "Abort."');
  225.   writeln(ScriptFile,UpDownStr,FilePath,FileName,' ',QTransfer);
  226.   writeln(ScriptFile);
  227.   if UpDown='U' then begin
  228.     writeln(ScriptFile,'WAITFOR "? "');
  229.     writeln(ScriptFile,'SEND "',FileDesc,'{"');
  230.     end;
  231.   writeln(ScriptFile,'NEXT',CountStr,':');
  232.   writeln(ScriptFile);
  233.   end;
  234.  
  235. procedure GetUpload;
  236. begin
  237.   write('Enter Upload File Name: ');
  238.   readln(FileName);
  239.   if FileName<>'' then begin
  240.     writeln('Enter drive and path for Upload File');
  241.     write('      d:\path\  ([C/R] for default): ');
  242.     readln(FilePath);
  243.     if FilePath <> '' then
  244.       if FilePath[length(FilePath)]<>'\' then FilePath := FilePath + '\';
  245.     writeln('Enter Upload Description:       [---------------------------------------]');
  246.     write('(start with / if for sysop only):');
  247.     readln(FileDesc);
  248.     if FileDesc<>'' then begin
  249.       write('Upload Type ');
  250.       WriteScript('U');
  251.       end;
  252.     end;
  253.   end;
  254.  
  255. procedure GetDownload;
  256. begin
  257.   write('Enter Download File Name: ');
  258.   readln(FileName);
  259.   FilePath := '';
  260.   if FileName<>'' then begin
  261.     write('Download Type ');
  262.     WriteScript('D');
  263.     end;
  264.   end;
  265.  
  266. procedure Hangup;
  267. begin
  268.   writeln(ScriptFile,'HANGUP');
  269.   writeln(ScriptFile);
  270.   writeln(ScriptFile,'.  ****  End of Session  ****');
  271.   end;
  272.  
  273. begin
  274.   clrscr;
  275.   writeln('Qmodem/PcBoard SCRIPT File Generator  --  by David W. Terry,  Feb 26, 1985');
  276.   OpenScript;
  277.   if FileName<>'' then begin
  278.     Count:=0;
  279.     gotoxy(1,4);
  280.     writeln('Script Function Menu');
  281.     writeln('--------------------');
  282.     writeln('  W = Wait until HH:MM');
  283.     writeln('  P = Dial Phone');
  284.     writeln('  L = Login');
  285.     writeln('  G = Logoff');
  286.     writeln('  E = Enter a Message (from file based Text)');
  287.     writeln('  U = Upload a file');
  288.     writeln('  D = Download a file');
  289.     writeln('  H = Hangup Phone');
  290.     writeln('  Q = Quit Script Generator');
  291.     window(1,16,80,25);
  292.     gotoxy(1,1);
  293.     repeat
  294.       writeln;
  295.       write('Enter Command: ');
  296.       readln(Command);
  297.       case upcase(Command) of
  298.         'W': GetWaitTime;
  299.         'P': DialPhone;
  300.         'L': Login;
  301.         'G': Logoff;
  302.         'E': EnterMessage;
  303.         'U': GetUpload;
  304.         'D': GetDownload;
  305.         'H': Hangup;
  306.         end;
  307.       until upcase(Command)='Q';
  308.     close(ScriptFile);
  309.     end;
  310.   window(1,1,80,25);
  311.   end.
  312.